﻿Public Class StarWars
    Inherits Puzzle

    Public Sub New()
        Size = 10
        SupportsRegioning = True
    End Sub

    Public Overrides Sub NewPuzzle()
        MyBase.NewPuzzle()
        Regions = New List(Of PuzzleStudio.Region)
    End Sub

    Public Overrides Sub Load(ByVal Data As String)
        Size = Math.Sqrt(Len(Data))
        NewPuzzle()
        For k = 0 To 9
            Dim s1 = InStr(Data, k) : If s1 = 0 Then Exit For
            Dim s2 = InStrRev(Data, k) : If s2 = 0 Then Exit For
            Dim Region As New Region
            Regions.Add(Region)
            For z = s1 To s2
                If Mid(Data, z, 1) = Trim(k) Then Region.Cells.Add(Cells(z - 1))
            Next
        Next
        Invalidate()
    End Sub

    Public Overrides Function Save() As String
        Dim Text As String = ""
        For i As Integer = 1 To Size * Size
            Text &= Cells(i - 1).Region
        Next
        Return Text
    End Function

    Public Overrides Sub Solve()
        ClearLog()
        For Each Cell In Cells
            Cell.f = ""
        Next
        Do
            For Each rr In From i In Range(1, Size - 1) From m In Range(1, 4)
                Dim i = rr.i
                Dim n = rr.m
                Dim a = (From c In Cells Where Choose(n, c.x, c.y, Size - c.x + 1, Size - c.y + 1) <= i From r In Regions Where r.Cells.Contains(c) Select r).Distinct
                If a.Count = i Then
                    For Each Cell In From c In Cells Where Choose(n, c.x, c.y, Size - c.x + 1, Size - c.y + 1) > i From r In a Where r.Cells.Contains(c) Select c Where c.f <> "x"
                        Cell.f = "x"
                    Next
                End If
            Next
            Dim Pairs = From r In Regions From c1 In r.Cells Where c1.f <> "x" From c2 In r.Cells.Except(c1.Neighbours) Where c2.f <> "x" And c1.i < c2.i Select r, c1, c2
            For Each Cell In From c In Cells Where Not (From p In Pairs Where p.c1 Is c).Any And Not (From p In Pairs Where p.c2 Is c).Any
                Cell.f = "x"
            Next
            Dim pc = From p In Pairs Group By r1 = p.r Into c1 = Count()
            Dim cc = From p In Pairs From cell In p.c1.Neighbours.Union(p.c2.Neighbours).Distinct Group By r2 = p.r, cell Into c2 = Count()
            Dim na = From a1 In pc From a2 In cc Where a1.r1 Is a2.r2 And a1.c1 = a2.c2 And a2.cell.f <> "x" Select a2.cell
            If na.Count = 0 Then Exit Do
            For Each C In na
                C.f = "x"
            Next
            Invalidate()
            MsgBox(1)
        Loop
        ReDim ux(Size)
        ReDim uy(Size)
        Dim Used As New List(Of Cell)
        CheckGroup(0, Used)
        FlushLog()
        Invalidate()
    End Sub

    Dim ux() As Integer, uy() As Integer

    Function CheckGroup(ByVal i As Integer, ByVal Used As List(Of Cell)) As Boolean
        If i = Regions.Count Then Return True
        Dim InvalidCells = From c In Used From n In c.Neighbours Select n
        Dim PossibleCells = (From c In Regions(i).Cells Where ux(c.x) < 2 AndAlso uy(c.y) < 2 AndAlso c.f <> "x").Except(InvalidCells)
        Dim Possibilities = From c1 In PossibleCells From c2 In PossibleCells.Except(c1.Neighbours) _
            Where c1.i < c2.i AndAlso Not ((c1.x = c2.x AndAlso ux(c1.x) > 0) Or (c1.y = c2.y AndAlso uy(c1.y) > 0))
        Dim z = 0
        For Each r In Possibilities
            z += 1
            If i < 2 Then Debug.Print(StrDup(i, "  ") & z & "/" & Possibilities.Count)
            r.c1.f = "*" : r.c2.f = "*"
            Used.Add(r.c1) : Used.Add(r.c2)
            ux(r.c1.x) += 1 : uy(r.c1.y) += 1
            ux(r.c2.x) += 1 : uy(r.c2.y) += 1
            If CheckGroup(i + 1, Used) Then Return True
            ux(r.c1.x) -= 1 : uy(r.c1.y) -= 1
            ux(r.c2.x) -= 1 : uy(r.c2.y) -= 1
            Used.Remove(r.c1) : Used.Remove(r.c2)
            r.c1.f = "" : r.c2.f = ""
        Next
    End Function

End Class
